﻿Imports System.Net.Sockets
Imports System.Threading
Public Class FServer
    Private LWriteTime As DateTime
    Private LReadTime As DateTime
    Private Listener As Socket
    Private ReadOnly mq As New Queue(Of System.Net.Sockets.Socket)
    Private ReadOnly msgq As New Queue(Of String)
    Private IsStop As Boolean
    Private ReadOnly dsmq As New Queue(Of DataSet)()
    Private Sub FServer_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
        NotifyIcon1.Icon = My.Resources.up_down
        NotifyIcon1.Text = "文件同步服务器"
        NotifyIcon1.Visible = True
        Button2.Enabled = False
        Icon = My.Resources.up_down
        IsStop = True
        TextBox2.Text = My.Settings.SAVEPath
        TextBox3.Text = My.Settings.FMaxThread
        TextBox4.Text = My.Settings.DBServer
        CheckBox1.Checked = My.Settings.AutoStart
        '开机启动
        My.Computer.Registry.SetValue("HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Run", "FSServer", Application.ExecutablePath)
        If CheckBox1.Checked Then
            Button1_Click(New Object, New System.EventArgs)
            Visible = False
        End If
    End Sub
    Private Sub Form1_LocationChanged(ByVal sender As Object, ByVal e As System.EventArgs) Handles Me.LocationChanged
        If WindowState = FormWindowState.Minimized Then
            Visible = False
        End If
    End Sub
    Private Sub NotifyIcon1_MouseClick(ByVal sender As System.Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles NotifyIcon1.MouseClick
        If Visible = False Then
            Visible = True
            WindowState = FormWindowState.Normal
        Else
            Visible = False
        End If
    End Sub

    Private Sub Button3_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button3.Click
        'DataGridView1.DataSource = Nothing
        TextBox1.Text = String.Empty
    End Sub

    Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
        IsStop = False
        Button1.Enabled = False
        Connstr = "Data Source=" & My.Settings.DBServer & ";Initial Catalog=" & My.Settings.DBName & ";User ID=" & My.Settings.DBUser & ";Password=" & My.Settings.DBPass & ";"
        msgq.Enqueue("启动计时器...")
        Timer2.Interval = 5000
        Timer2.Enabled = True
        Timer2.Start()

        Timer1.Interval = 500
        Timer1.Enabled = True
        Timer1.Start()
        msgq.Enqueue("设置线程池...")
        ThreadPool.SetMaxThreads(My.Settings.FMaxThread, My.Settings.FMaxThread)
        ThreadPool.SetMinThreads(5, 5)
        
        Try
            '----启动监控线程
            '--测试数据连接
            Dim ErrString As String = String.Empty
            Dim Tconn As New SqlClient.SqlConnection(Connstr)
            If DControl.OpenDB(New SqlClient.SqlConnection, ErrString) = False Then
                msgq.Enqueue("连接数据库失败!错误信息:" & ErrString)
                Timer2.Stop()
                ErrString = Nothing
                Tconn.Dispose()
                Tconn = Nothing
                IsStop = True
                Button1.Enabled = True
                Return
            End If
            ErrString = Nothing
            Tconn.Dispose()
            Tconn = Nothing
            '----检查目录
            msgq.Enqueue("检查存放路径...")
            If IO.Directory.Exists(My.Settings.SAVEPath) = False Then
                msgq.Enqueue(String.Format("文件夹不存在,创建'{0}'...", My.Settings.SAVEPath))
                Try
                    IO.Directory.CreateDirectory(My.Settings.SAVEPath)
                    msgq.Enqueue("创建成功!")
                Catch ex As Exception
                    msgq.Enqueue("创建失败!错误信息:" & ex.Message)
                    msgq.Enqueue("启动过程停止!")
                    Button1.Enabled = True
                    Button2.Enabled = False
                    IsStop = True
                    Return
                End Try
            End If
            msgq.Enqueue("建立终结点...")
            Dim EP As New Net.IPEndPoint(Net.IPAddress.Parse("0.0.0.0"), 8800)
            msgq.Enqueue(String.Format("成功!{0}创建套接字...", vbCrLf))
            Listener = New Socket(AddressFamily.InterNetwork, SocketType.Stream, ProtocolType.Tcp)
            msgq.Enqueue(String.Format("成功{0}绑定端口...", vbCrLf))
            Listener.Bind(EP)
            msgq.Enqueue(String.Format("成功!{0}启动套接字...", vbCrLf))
            Listener.Listen(15)
            msgq.Enqueue(String.Format("成功!{0}开始接收连接请求...", vbCrLf))
            Dim NSOcket As Socket = Nothing
            Listener.BeginAccept(AddressOf FCallBack, NSOcket)
            Button2.Enabled = True
        Catch ex As Exception
            msgq.Enqueue(String.Format("出错{0}{1}", vbCrLf, ex.Message))
            Button1.Enabled = True
            Button2.Enabled = False
            IsStop = True
        End Try

    End Sub

    Private Sub FListen()
        msgq.Enqueue("重启连接监控...")
        Try
            Dim NSOcket As Socket = Nothing
            Listener.BeginAccept(AddressOf FCallBack, NSOcket)
            msgq.Enqueue("成功!")

        Catch ex As Exception
            msgq.Enqueue(String.Format("失败!{0}错误信息:{1}", vbCrLf, ex.Message))
            IsStop = True
        End Try

    End Sub

    Private Sub FCallBack(ByVal ar As IAsyncResult)
        Try
            If IsStop = True Then
                msgq.Enqueue("服务器已停止,不再接收新连接!")
                Return
            End If
            msgq.Enqueue("接收到新连接,解析套接字...")
            Dim sender As Socket = Listener.EndAccept(ar)
            msgq.Enqueue("新连接加入队列...")
            mq.Enqueue(sender)
            msgq.Enqueue(String.Format("成功!{0}准备加入队列...", vbCrLf))
            ThreadPool.QueueUserWorkItem(AddressOf TProcess)
            msgq.Enqueue("成功加入线程池队列")
            If IsStop = True Then
                Return
            End If
            FListen()

            'Dim th1 As New Thread(AddressOf FListen)
            'th1.Start()
            'th1 = Nothing
        Catch ex As Exception
            ThreadPool.QueueUserWorkItem(New WaitCallback(AddressOf FListen))
        End Try

    End Sub
    Private Sub TProcess()
        '--为节省时间和资源,所有错误的消息都不处理直接断开连接
        '--软件局域网自用,所以不考虑严谨问题,接收文件不会进行匹配,全部当作不存在,不考虑改名问题.
        '--对比文件日期时只判断是否相同,不考虑时间前后问题.
        '--只要数据库中存在即当作实际文件存在,不考虑删除问题
        '--文件大小问题,传输时的长度全部使用的是int32,所以文件不能超过2GB,否则无法接收.自用没有大于2G的所以不考虑此问题
        '-----获取套接字
        Dim sender As Socket = mq.Dequeue
        If sender Is Nothing Then
            msgq.Enqueue("连接丢失!")
            Return
        End If
        Try

            '-----设置接收缓冲区为200MB,发送缓冲0.2M,此处设置为200MB会占用大量系统资源,客户端发送缓冲区也要修改,否则会出错
            sender.ReceiveBufferSize = 209715200
            sender.SendBufferSize = 209715
            '-----接收数据
            Dim FRecv As Byte() = Nothing
            Dim FRecved As Integer = 0
            'If FRecved < 5 Then
            '    '----接收错误,直接断开连接
            '    sender.Close()
            '    sender = Nothing
            '    Return
            'End If
            '-------定义字符串转换实例
            Dim CVT As New Text.UTF8Encoding
            '-------定义变量
            Dim pLength As Integer = 0
            Dim nLength As Integer = 0
            Dim sFileName As String = String.Empty
            Dim sClientName As String = String.Empty
            Dim FileDate As Date = Nothing
            Dim FCEP As Net.IPEndPoint = sender.RemoteEndPoint
            Dim FCIP As String = FCEP.Address.ToString
            '-------解析接收到的数据
            Dim RString As String = String.Empty
            '-------处理操作
            While IsStop = False
                FRecv = New Byte(4) {}
                FRecved = 0
                FRecved = sender.Receive(FRecv, 5, SocketFlags.None)
                If FRecved < 5 Then
                    '----接收错误,直接断开连接
                    sender.Close()
                    sender = Nothing
                    Return
                End If
                RString = CVT.GetString(FRecv)

                Select Case RString
                    Case "CLNME"
                        '----客户端发送自己的名字
                        '---接收长度
                        Dim NameLength As Integer = 0
                        FRecv = New Byte(3) {}

                        FRecved = sender.Receive(FRecv, 4, SocketFlags.None)
                        If FRecved < 4 Then
                            '---出错,退出
                            sender.Close()
                            sender.Dispose()
                            sender = Nothing
                            Exit Sub
                        End If
                        '----转换为数字
                        NameLength = BitConverter.ToInt32(FRecv, 0)
                        If NameLength < 1 Then
                            '----出错,直接断开连接
                            sender.Close()
                            sender.Dispose()
                            sender = Nothing
                            Exit Sub
                        End If
                        '----接收客户端名
                        FRecv = New Byte(NameLength - 1) {}
                        FRecved = sender.Receive(FRecv, NameLength, SocketFlags.None)
                        If FRecved < NameLength Then
                            '---接收出错,退出
                            sender.Close()
                            sender.Dispose()
                            sender = Nothing
                            Exit Sub
                        End If
                        '----转换为名字
                        sClientName = CVT.GetString(FRecv)
                        If Trim(sClientName) = String.Empty Then
                            '----转换出错,退出线程
                            sender.Close()
                            sender = Nothing
                            Exit Sub
                        End If
                    Case "SFILE"

                        '----传送文件
                        FRecved = 0
                        pLength = 0
                        nLength = 0
                        sFileName = String.Empty
                        '---接收文件长度
                        FRecv = New Byte(3) {}
                        FRecved = sender.Receive(FRecv, 4, SocketFlags.None)
                        If FRecved < 4 Then
                            '---出错,退出
                            sender.Close()
                            sender = Nothing
                            Exit Sub
                        End If
                        '----转换接收到的数据
                        pLength = BitConverter.ToInt32(FRecv, 0)
                        If pLength < 1 Then
                            '---错误,发送错误标志断开连接
                            sender.Close()
                            sender.Dispose()
                            sender = Nothing
                            Exit Sub
                        End If

                        '----接收文件名长度
                        FRecved = 0
                        FRecv = New Byte(3) {}

                        FRecved = sender.Receive(FRecv, 4, SocketFlags.None)
                        If FRecved < 4 Then
                            '出错,退出
                            sender.Close()
                            sender = Nothing
                            Exit Sub
                        End If
                        '----转换文件名长度
                        nLength = BitConverter.ToInt32(FRecv, 0)
                        If nLength < 1 Then
                            '----错误,不处理直接断开
                            sender.Close()
                            sender.Dispose()
                            sender = Nothing
                            Exit Sub
                        End If
                        '----接收文件名
                        FRecv = New Byte(nLength - 1) {}
                        FRecved = sender.Receive(FRecv, nLength, SocketFlags.None)
                        If FRecved < nLength Then
                            '----出错,直接断开
                            sender.Close()
                            sender = Nothing
                            Exit Sub
                        End If
                        '----转换为字符串
                        sFileName = CVT.GetString(FRecv)
                        If Trim(sFileName) = String.Empty Then
                            '--转换失败,退出
                            sender.Close()
                            sender.Dispose()
                            sender = Nothing
                            Exit Sub
                        End If
                        '---文件全名
                        Dim nFileINFO As New IO.FileInfo(String.Format("{0}\{1}\{2}".Replace("\\", "\"), My.Settings.SAVEPath, sClientName, sFileName))

                        '----检查客户端目录是否存在
                        If IO.Directory.Exists(nFileINFO.DirectoryName) = False Then
                            '----创建客户端文件夹
                            IO.Directory.CreateDirectory(nFileINFO.DirectoryName)
                        End If
                        '----接收文件,文件存在直接覆盖
                        Dim fw As IO.FileStream = New IO.FileStream(nFileINFO.FullName, IO.FileMode.OpenOrCreate, IO.FileAccess.ReadWrite)

                        FRecved = 0
                        Dim TmpR As Integer = 0
                        '----此处有可能会出现无限循环,目前还没有好办法解决
                        While FRecved < pLength

                            TmpR = sender.Available
                            FRecv = New Byte(TmpR - 1) {}
                            FRecved += sender.Receive(FRecv, TmpR, SocketFlags.None)
                            fw.Write(FRecv, 0, FRecv.Length)

                        End While
                        fw.Flush()
                        fw.Close()
                        fw.Dispose()
                        fw = Nothing
                        '--接收完后写入数据库记录,不考虑失败问题,不成功就拉倒
                        Dim sqlstr As String = String.Format("select * from T_Files where FCLName='{0}' and FName='{1}'", sClientName, sFileName)
                        Dim ErrString As String = String.Empty
                        Dim ds As New DataSet
                        '--查找是否存在记录
                        If DControl.QuerySQL(sqlstr, ds, ErrString) = False Then
                            sender.Send(CVT.GetBytes("ABCDE"))
                            Continue While
                        End If
                        If ds.Tables.Count < 1 Then
                            sender.Send(CVT.GetBytes("ABCDE"))
                            Continue While
                        End If
                        If ds.Tables(0).Rows.Count < 1 Then
                            '---没数据,直接插入新记录
                            sqlstr = String.Format("insert into T_Files(FCLName,FName,FDate,FUPDate,FIP) values('{0}','{1}','{2}',Getdate(),'{3}')", sClientName, sFileName, CStr(FileDate), FCIP)
                        Else
                            '---有数据,更新
                            sqlstr = String.Format("update T_Files set FUPDate=Getdate(),FIP='{0}' where FCLName='{1}' and FName='{2}'", FCIP, sClientName, sFileName)
                        End If
                        '--执行SQL,不考虑是否成功
                        DControl.ExecSQL(sqlstr, ErrString)
                        LWriteTime = Now
                        sender.Send(CVT.GetBytes("ABCDE"))
                    Case "CFILE"

                        '----比较文件
                        FRecved = 0
                        nLength = 0
                        sFileName = String.Empty

                        '---接收包长度信息
                        FRecv = New Byte(3) {}
                        FRecved = sender.Receive(FRecv, 4, SocketFlags.None)
                        If FRecved < 4 Then
                            '--错误,断开
                            sender.Close()
                            sender = Nothing
                            Exit Sub
                        End If
                        '----转换成数字
                        nLength = BitConverter.ToInt32(FRecv, 0)
                        If nLength < 1 Then
                            '错误,退出
                            sender.Close()
                            sender.Dispose()
                            sender = Nothing
                            Exit Sub
                        End If
                        '----接收文件名
                        FRecv = New Byte(nLength - 1) {}
                        FRecved = sender.Receive(FRecv, nLength, SocketFlags.None)
                        If FRecved < nLength Then
                            '出错,退出
                            sender.Close()
                            sender.Dispose()
                            sender = Nothing
                            Exit Sub
                        End If
                        '--转换为字符串
                        sFileName = CVT.GetString(FRecv)
                        If Trim(sFileName) = String.Empty Then
                            '出错,退出
                            sender.Close()
                            sender.Dispose()
                            sender = Nothing
                            Exit Sub
                        End If
                        '---接收日期长度
                        FRecv = New Byte(3) {}
                        FRecved = sender.Receive(FRecv, 4, SocketFlags.None)
                        If FRecved < 4 Then
                            '出错,退出
                            sender.Close()
                            sender.Dispose()
                            sender = Nothing
                            Exit Sub
                        End If
                        '--转换为数字
                        Dim tmpR As Integer = BitConverter.ToInt32(FRecv, 0)
                        If tmpR < 1 Then
                            '出错,退出
                            sender.Close()
                            sender.Dispose()
                            sender = Nothing
                            Exit Sub
                        End If
                        '---接收日期
                        FRecv = New Byte(tmpR - 1) {}
                        FRecved = sender.Receive(FRecv, tmpR, SocketFlags.None)
                        If FRecved < tmpR Then
                            '出错,退出
                            sender.Close()
                            sender.Dispose()
                            sender = Nothing
                            Exit Sub
                        End If
                        '--转换为字符串
                        FileDate = CDate(CVT.GetString(FRecv))
                        If FileDate = Nothing Then
                            '出错,退出
                            sender.Close()
                            sender.Dispose()
                            sender = Nothing
                            Exit Sub
                        End If
                        '---比较修改日期
                        Dim sqlstr As String = String.Format("select * from T_Files where FCLName='{0}' and FName='{1}'", sClientName, sFileName)
                        Dim ErrString As String = String.Empty
                        Dim ds As New DataSet
                        If DControl.QuerySQL(sqlstr, ds, ErrString) = False Then
                            msgq.Enqueue("比较文件错误:" & ErrString)
                            '---返回不处理标志
                            sender.Send(CVT.GetBytes("CFIOK"))
                        Else
                            '----检查查询到的数据
                            If ds.Tables.Count < 1 Then
                                '---返回不处理标志
                                sender.Send(CVT.GetBytes("CFIOK"))
                                Exit Select
                            End If
                            If ds.Tables(0).Rows.Count < 1 Then
                                '---返回需要同步
                                sender.Send(CVT.GetBytes("CFUPD"))
                                Exit Select
                            End If
                            '----比较日期
                            If FileDate <> ds.Tables(0).Rows(0).Item("FDate") Then
                                '---日期不同
                                '---返回需要同步
                                sender.Send(CVT.GetBytes("CFUPD"))
                                Exit Select
                            Else
                                '---返回删除客户端文件
                                sender.Send(CVT.GetBytes("CFDEL"))
                                Exit Select
                            End If
                        End If
                    Case "LGOUT"
                        '----断开连接
                        sender.Close()
                        sender.Dispose()
                        sender = Nothing
                        Exit Sub
                    Case Else

                        '----错误信息,直接退出
                        msgq.Enqueue("线程退出,接收错误数据:" & RString)
                        sender.Close()
                        sender.Dispose()
                        sender = Nothing
                        Exit Sub
                End Select
            End While
            sender.Close()
            sender.Dispose()
            sender = Nothing
        Catch ex As Exception
            msgq.Enqueue("线程退出:" & ex.Message)
            sender.Close()
            sender.Dispose()
            sender = Nothing
        End Try


    End Sub

    Private Sub Timer1_Tick(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Timer1.Tick
        Dim F1 As Integer = 0
        Dim FMax As Integer = 0
        Dim FFree As Integer = 0
        Dim FACtive As Integer = 0
        ThreadPool.GetMaxThreads(FMax, F1)
        ThreadPool.GetAvailableThreads(FFree, F1)
        FACtive = FMax - FFree
        Label1.Text = "最大线程数:" & FMax
        Label2.Text = "活动线程数:" & FACtive
        If TextBox1.TextLength > TextBox1.MaxLength / 2 Then
            TextBox1.Text = Nothing
        End If
        If msgq.Count > 0 Then
            For i As Integer = 0 To msgq.Count - 1
                TextBox1.AppendText(msgq.Dequeue & vbCrLf)
            Next
        End If
        If dsmq.Count > 0 Then
            DataGridView1.DataSource = dsmq.Dequeue.Tables(0).DefaultView
        End If
    End Sub

    Private Sub Button2_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button2.Click
        Try
            IsStop = True
            '---等待线程结束
            msgq.Enqueue("关闭套接字...")
            msgq.Enqueue("释放资源...")
            Listener.Close()
            Listener.Dispose()
            msgq.Enqueue("成功!")
            Button2.Enabled = False
            Button1.Enabled = True
            msgq.Enqueue("等待线程结束...")
            While Trim(Label2.Text) <> "活动线程数:0"
                Application.DoEvents()
                Thread.Sleep(10)
            End While
            msgq.Enqueue("停止计时器...")
            While msgq.Count > 0 Or dsmq.Count > 0
                Application.DoEvents()
                Thread.Sleep(10)
            End While
            Label1.Text = "最大线程数:0"
            Label2.Text = "活动线程数:0"
            Timer1.Stop()
            Timer2.Stop()
        Catch ex As Exception
            Button2.Enabled = False
            Button1.Enabled = True
            msgq.Enqueue(String.Format("失败{0}错误信息:{1}", vbCrLf, ex.Message))
        End Try
    End Sub

    Private Sub Button5_Click(sender As Object, e As EventArgs) Handles Button5.Click
        FolderBrowserDialog1.SelectedPath = Nothing
        If FolderBrowserDialog1.ShowDialog = Windows.Forms.DialogResult.Cancel Then
            Return
        Else
            TextBox2.Text = FolderBrowserDialog1.SelectedPath
        End If
    End Sub

    Private Sub Button4_Click(sender As Object, e As EventArgs) Handles Button4.Click
        My.Settings.DBServer = Trim(TextBox4.Text)
        My.Settings.FMaxThread = Trim(TextBox3.Text)
        My.Settings.SAVEPath = Trim(TextBox2.Text)
        My.Settings.AutoStart = CheckBox1.Checked
        My.Settings.Save()
    End Sub

    Private Sub Timer2_Tick(sender As Object, e As EventArgs) Handles Timer2.Tick
        If LWriteTime > LReadTime Then
            LReadTime = Now
            '--最后写入数据的时间大于上次读取时间,重新读取更新记录
            Dim sqlstr As String = "select TOP 20 FCLName '客户端',FName '文件名',FUPDate '日期',FIP 'IP' from T_Files Order By id Desc"
            Dim ds As DataSet = New DataSet
            DControl.QuerySQL(sqlstr, ds)
            If ds.Tables.Count < 1 Then
                Return
            End If
            dsmq.Enqueue(ds)
            ds.Dispose()
            ds = Nothing
        End If
        
    End Sub
End Class
